Activity: Spatially Continuous Data III

Practice questions

Answer the following questions:

  1. What is a correlogram?
  2. What is the relationship between the autocovariance and the semivariance?
  3. Describe the elements of a semivariogram.
  4. Why is it important to consider the number of pairs used in the calculation of the semivariance?

Learning objectives

In this activity, you will:

  1. Calculate and plot empirical semivariograms.
  2. Estimate and plot theoretical semivariograms.
  3. Discuss the results of variographic analysis.

Suggested reading

  • Bailey TC and Gatrell AC [-@Bailey1995] Interactive Spatial Data Analysis, Chapters 5 and 6. Longman: Essex.
  • Bivand RS, Pebesma E, and Gomez-Rubio V [-@Bivand2008] Applied Spatial Data Analysis with R, Chapter 8. Springer: New York.
  • Brunsdon C and Comber L [-@Brunsdon2015R] An Introduction to R for Spatial Analysis and Mapping, Chapter 6, Sections 6.7 and 6.8. Sage: Los Angeles.
  • Isaaks EH and Srivastava RM [-@Isaaks1989applied] An Introduction to Applied Geostatistics, CHAPTERS. Oxford University Press: Oxford.
  • O’Sullivan D and Unwin D [-@Osullivan2010] Geographic Information Analysis, 2nd Edition, Chapters 9 and 10. John Wiley & Sons: New Jersey.

Preliminaries

For this activity you will need the following:

  • An R markdown notebook version of this document (the source file).

  • A package called geog4ga3.

It is good practice to clear the working space to make sure that you do not have extraneous items there when you begin your work. The command in R to clear the workspace is rm (for “remove”), followed by a list of items to be removed. To clear the workspace from all objects, do the following:

rr rm(list = ls())

Note that ls() lists all objects currently on the worspace.

Load the libraries you will use in this activity (load other packages as appropriate).

library(tidyverse)
library(gstat)
package 㤼㸱gstat㤼㸲 was built under R version 3.5.3
Attaching package: 㤼㸱gstat㤼㸲

The following object is masked from 㤼㸱package:spatstat㤼㸲:

    idw
library(spdep)
library(geog4ga3)

Load dataset:

data("aquifer")

Convert to a SpatialPointsDataFrame:

aquifer.sp <- aquifer
coordinates(aquifer.sp) <- ~X+Y

The data is a set of piezometric head (watertable pressure) observations of the Wolfcamp Aquifer in Texas (https://en.wikipedia.org/wiki/Hydraulic_head). Measures of pressure can be used to infer the flow of underground water, since water flows from high to low pressure areas.

These data were collected to evaluate potential flow of contamination related to a high level toxic waste repository in Texas. The Deaf Smith county site in Texas was one of three potential sites proposed for this repository. Beneath the site is a deep brine aquifer known as the Wolfcamp aquifer that may serve as a conduit of contamination leaking from the repository.

The data set consists of 85 georeferenced measurements of piezometric head. Possible applications of interpolation are to determine sites at risk and to quantify uncertainty of the interpolated surface, to evaluate the best locations for monitoring stations.

Activity

  1. Obtain and plot the empirical semivariogram for the head in the Walker Lake dataset. How would you interpret this semivariogram?
variogram_z <- variogram(H ~ 1, data = aquifer.sp)
ggplot(data = variogram_z, aes(x = dist, y = gamma)) +
  geom_point() + 
  geom_text(aes(label = np), nudge_y = -1500) +
  xlab("Distance") + ylab("Semivariance")

  1. Estimate trend surface of your choice, and obtain and plot an empirical semivariogram using the residuals. How would you interpret this semivariogram?
trend.l <- lm(formula = H ~ X + Y, data = aquifer)
summary(trend.l)

Call:
lm(formula = H ~ X + Y, data = aquifer)

Residuals:
    Min      1Q  Median      3Q     Max 
-367.00 -161.41  -30.74  148.23  651.17 

Coefficients:
             Estimate Std. Error t value Pr(>|t|)    
(Intercept) 2591.3266    38.9636   66.51   <2e-16 ***
X             -6.7519     0.3439  -19.64   <2e-16 ***
Y             -5.9862     0.4066  -14.72   <2e-16 ***
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Residual standard error: 203.3 on 82 degrees of freedom
Multiple R-squared:  0.892, Adjusted R-squared:  0.8894 
F-statistic: 338.8 on 2 and 82 DF,  p-value: < 2.2e-16
u.p <- seq(from = 0.0, to = 1.0, by = 0.05)
v.p <- seq(from = 0.0, to = 1.0, by = 0.05)
preds <- predict(trend.l, newdata = aquifer, se.fit = TRUE, interval = "prediction", level = 0.95)
z.p <- matrix(data = preds$fit[,1], nrow = 21, ncol = 21, byrow = TRUE)
data length [85] is not a sub-multiple or multiple of the number of rows [21]
z.p_l <- matrix(data = preds$fit[,2], nrow = 21, ncol = 21, byrow = TRUE)
data length [85] is not a sub-multiple or multiple of the number of rows [21]
z.p_u <- matrix(data = preds$fit[,3], nrow = 21, ncol = 21, byrow = TRUE)
data length [85] is not a sub-multiple or multiple of the number of rows [21]
trend.plot <- plot_ly(x = ~u.p, y = ~v.p, z = ~z.p, 
        type = "surface", colors = "YlOrRd") %>% 
  add_surface(x = ~u.p, y = ~v.p, z = ~z.p_l, 
              opacity = 0.5, showscale = FALSE) %>%
  add_surface(x = ~u.p, y = ~v.p, z = ~z.p_u, 
              opacity = 0.5, showscale = FALSE) %>% 
  layout(scene = list(
    aspectmode = "manual", aspectratio = list(x = 1, y = 1, z = 1)))
trend.plot #%>% add_markers(data = df, x = ~x, y = ~y, z = ~z, color = ~residual)
  1. Estimate and plot a theoretical semivariogram model for the residual variogram.
aquifer$residual1 <- ifelse(trend.l$residuals > 0, "Positive", "Negative")
ggplot(data = aquifer, 
       aes(x = X, y = Y, color = residual1)) +
  geom_point() +
  coord_equal()

  1. How would you use the information provided by the variographic analysis above to improve your predictions of the field?
LS0tDQp0aXRsZTogIkFjdGl2aXR5OiBTcGF0aWFsbHkgQ29udGludW91cyBEYXRhIElJSSINCm91dHB1dDogaHRtbF9ub3RlYm9vaw0KLS0tDQoNCiMgQWN0aXZpdHk6IFNwYXRpYWxseSBDb250aW51b3VzIERhdGEgSUlJDQoNCiMjIFByYWN0aWNlIHF1ZXN0aW9ucw0KDQpBbnN3ZXIgdGhlIGZvbGxvd2luZyBxdWVzdGlvbnM6DQoNCjEuIFdoYXQgaXMgYSBjb3JyZWxvZ3JhbT8NCjIuIFdoYXQgaXMgdGhlIHJlbGF0aW9uc2hpcCBiZXR3ZWVuIHRoZSBhdXRvY292YXJpYW5jZSBhbmQgdGhlIHNlbWl2YXJpYW5jZT8NCjMuIERlc2NyaWJlIHRoZSBlbGVtZW50cyBvZiBhIHNlbWl2YXJpb2dyYW0uDQo0LiBXaHkgaXMgaXQgaW1wb3J0YW50IHRvIGNvbnNpZGVyIHRoZSBudW1iZXIgb2YgcGFpcnMgdXNlZCBpbiB0aGUgY2FsY3VsYXRpb24gb2YgdGhlIHNlbWl2YXJpYW5jZT8NCg0KIyMgTGVhcm5pbmcgb2JqZWN0aXZlcw0KDQpJbiB0aGlzIGFjdGl2aXR5LCB5b3Ugd2lsbDoNCg0KMS4gQ2FsY3VsYXRlIGFuZCBwbG90IGVtcGlyaWNhbCBzZW1pdmFyaW9ncmFtcy4NCjIuIEVzdGltYXRlIGFuZCBwbG90IHRoZW9yZXRpY2FsIHNlbWl2YXJpb2dyYW1zLg0KMy4gRGlzY3VzcyB0aGUgcmVzdWx0cyBvZiB2YXJpb2dyYXBoaWMgYW5hbHlzaXMuDQoNCiMjIFN1Z2dlc3RlZCByZWFkaW5nDQoNCi0gQmFpbGV5IFRDIGFuZCBHYXRyZWxsIEFDIFstQEJhaWxleTE5OTVdIEludGVyYWN0aXZlIFNwYXRpYWwgRGF0YSBBbmFseXNpcywgQ2hhcHRlcnMgNSBhbmQgNi4gTG9uZ21hbjogRXNzZXguDQotIEJpdmFuZCBSUywgUGViZXNtYSBFLCBhbmQgR29tZXotUnViaW8gViBbLUBCaXZhbmQyMDA4XSBBcHBsaWVkIFNwYXRpYWwgRGF0YSBBbmFseXNpcyB3aXRoIFIsIENoYXB0ZXIgOC4gU3ByaW5nZXI6IE5ldyBZb3JrLg0KLSBCcnVuc2RvbiBDIGFuZCBDb21iZXIgTCBbLUBCcnVuc2RvbjIwMTVSXSBBbiBJbnRyb2R1Y3Rpb24gdG8gUiBmb3IgU3BhdGlhbCBBbmFseXNpcyBhbmQgTWFwcGluZywgQ2hhcHRlciA2LCBTZWN0aW9ucyA2LjcgYW5kIDYuOC4gU2FnZTogTG9zIEFuZ2VsZXMuDQotIElzYWFrcyBFSCBhbmQgU3JpdmFzdGF2YSBSTSAgWy1ASXNhYWtzMTk4OWFwcGxpZWRdIEFuIEludHJvZHVjdGlvbiB0byBBcHBsaWVkIEdlb3N0YXRpc3RpY3MsICoqQ0hBUFRFUlMqKi4gT3hmb3JkIFVuaXZlcnNpdHkgUHJlc3M6IE94Zm9yZC4NCi0gTydTdWxsaXZhbiBEIGFuZCBVbndpbiBEIFstQE9zdWxsaXZhbjIwMTBdIEdlb2dyYXBoaWMgSW5mb3JtYXRpb24gQW5hbHlzaXMsIDJuZCBFZGl0aW9uLCBDaGFwdGVycyA5IGFuZCAxMC4gSm9obiBXaWxleSAmIFNvbnM6IE5ldyBKZXJzZXkuDQoNCiMjIFByZWxpbWluYXJpZXMNCg0KRm9yIHRoaXMgYWN0aXZpdHkgeW91IHdpbGwgbmVlZCB0aGUgZm9sbG93aW5nOg0KDQoqIEFuIFIgbWFya2Rvd24gbm90ZWJvb2sgdmVyc2lvbiBvZiB0aGlzIGRvY3VtZW50ICh0aGUgc291cmNlIGZpbGUpLg0KDQoqIEEgcGFja2FnZSBjYWxsZWQgYGdlb2c0Z2EzYC4NCg0KSXQgaXMgZ29vZCBwcmFjdGljZSB0byBjbGVhciB0aGUgd29ya2luZyBzcGFjZSB0byBtYWtlIHN1cmUgdGhhdCB5b3UgZG8gbm90IGhhdmUgZXh0cmFuZW91cyBpdGVtcyB0aGVyZSB3aGVuIHlvdSBiZWdpbiB5b3VyIHdvcmsuIFRoZSBjb21tYW5kIGluIFIgdG8gY2xlYXIgdGhlIHdvcmtzcGFjZSBpcyBgcm1gIChmb3IgInJlbW92ZSIpLCBmb2xsb3dlZCBieSBhIGxpc3Qgb2YgaXRlbXMgdG8gYmUgcmVtb3ZlZC4gVG8gY2xlYXIgdGhlIHdvcmtzcGFjZSBmcm9tIF9hbGxfIG9iamVjdHMsIGRvIHRoZSBmb2xsb3dpbmc6DQpgYGB7cn0NCnJtKGxpc3QgPSBscygpKQ0KYGBgDQoNCk5vdGUgdGhhdCBgbHMoKWAgbGlzdHMgYWxsIG9iamVjdHMgY3VycmVudGx5IG9uIHRoZSB3b3JzcGFjZS4NCg0KTG9hZCB0aGUgbGlicmFyaWVzIHlvdSB3aWxsIHVzZSBpbiB0aGlzIGFjdGl2aXR5IChsb2FkIG90aGVyIHBhY2thZ2VzIGFzIGFwcHJvcHJpYXRlKS4gDQpgYGB7cn0NCmxpYnJhcnkodGlkeXZlcnNlKQ0KbGlicmFyeShnc3RhdCkNCmxpYnJhcnkoc3BkZXApDQpsaWJyYXJ5KGdlb2c0Z2EzKQ0KYGBgDQoNCkxvYWQgZGF0YXNldDoNCmBgYHtyfQ0KZGF0YSgiYXF1aWZlciIpDQpgYGANCg0KQ29udmVydCB0byBhIGBTcGF0aWFsUG9pbnRzRGF0YUZyYW1lYDoNCmBgYHtyfQ0KYXF1aWZlci5zcCA8LSBhcXVpZmVyDQpjb29yZGluYXRlcyhhcXVpZmVyLnNwKSA8LSB+WCtZDQpgYGANCg0KVGhlIGRhdGEgaXMgYSBzZXQgb2YgcGllem9tZXRyaWMgaGVhZCAod2F0ZXJ0YWJsZSBwcmVzc3VyZSkgb2JzZXJ2YXRpb25zIG9mIHRoZSBXb2xmY2FtcCBBcXVpZmVyIGluIFRleGFzIChodHRwczovL2VuLndpa2lwZWRpYS5vcmcvd2lraS9IeWRyYXVsaWNfaGVhZCkuIE1lYXN1cmVzIG9mIHByZXNzdXJlIGNhbiBiZSB1c2VkIHRvIGluZmVyIHRoZSBmbG93IG9mIHVuZGVyZ3JvdW5kIHdhdGVyLCBzaW5jZSB3YXRlciBmbG93cyBmcm9tIGhpZ2ggdG8gbG93IHByZXNzdXJlIGFyZWFzLg0KDQpUaGVzZSBkYXRhIHdlcmUgY29sbGVjdGVkIHRvIGV2YWx1YXRlIHBvdGVudGlhbCBmbG93IG9mIGNvbnRhbWluYXRpb24gcmVsYXRlZCB0byBhIGhpZ2ggbGV2ZWwgdG94aWMgd2FzdGUgcmVwb3NpdG9yeSBpbiBUZXhhcy4gVGhlIERlYWYgU21pdGggY291bnR5IHNpdGUgaW4gVGV4YXMgd2FzIG9uZSBvZiB0aHJlZSBwb3RlbnRpYWwgc2l0ZXMgcHJvcG9zZWQgZm9yIHRoaXMgcmVwb3NpdG9yeS4gQmVuZWF0aCB0aGUgc2l0ZSBpcyBhIGRlZXAgYnJpbmUgYXF1aWZlciBrbm93biBhcyB0aGUgV29sZmNhbXAgYXF1aWZlciB0aGF0IG1heSBzZXJ2ZSBhcyBhIGNvbmR1aXQgb2YgY29udGFtaW5hdGlvbiBsZWFraW5nIGZyb20gdGhlIHJlcG9zaXRvcnkuDQoNClRoZSBkYXRhIHNldCBjb25zaXN0cyBvZiA4NSBnZW9yZWZlcmVuY2VkIG1lYXN1cmVtZW50cyBvZiBwaWV6b21ldHJpYyBoZWFkLiBQb3NzaWJsZSBhcHBsaWNhdGlvbnMgb2YgaW50ZXJwb2xhdGlvbiBhcmUgdG8gZGV0ZXJtaW5lIHNpdGVzIGF0IHJpc2sgYW5kIHRvIHF1YW50aWZ5IHVuY2VydGFpbnR5IG9mIHRoZSBpbnRlcnBvbGF0ZWQgc3VyZmFjZSwgdG8gZXZhbHVhdGUgdGhlIGJlc3QgbG9jYXRpb25zIGZvciBtb25pdG9yaW5nIHN0YXRpb25zLg0KDQojIyBBY3Rpdml0eQ0KDQoxLiBPYnRhaW4gYW5kIHBsb3QgdGhlIGVtcGlyaWNhbCBzZW1pdmFyaW9ncmFtIGZvciB0aGUgaGVhZCBpbiB0aGUgV2Fsa2VyIExha2UgZGF0YXNldC4gSG93IHdvdWxkIHlvdSBpbnRlcnByZXQgdGhpcyBzZW1pdmFyaW9ncmFtPw0KDQpgYGB7cn0NCnZhcmlvZ3JhbV96IDwtIHZhcmlvZ3JhbShIIH4gMSwgZGF0YSA9IGFxdWlmZXIuc3ApDQpnZ3Bsb3QoZGF0YSA9IHZhcmlvZ3JhbV96LCBhZXMoeCA9IGRpc3QsIHkgPSBnYW1tYSkpICsNCiAgZ2VvbV9wb2ludCgpICsgDQogIGdlb21fdGV4dChhZXMobGFiZWwgPSBucCksIG51ZGdlX3kgPSAtMTUwMCkgKw0KICB4bGFiKCJEaXN0YW5jZSIpICsgeWxhYigiU2VtaXZhcmlhbmNlIikNCmBgYA0KDQoyLiBFc3RpbWF0ZSB0cmVuZCBzdXJmYWNlIG9mIHlvdXIgY2hvaWNlLCBhbmQgb2J0YWluIGFuZCBwbG90IGFuIGVtcGlyaWNhbCBzZW1pdmFyaW9ncmFtIHVzaW5nIHRoZSByZXNpZHVhbHMuIEhvdyB3b3VsZCB5b3UgaW50ZXJwcmV0IHRoaXMgc2VtaXZhcmlvZ3JhbT8NCg0KYGBge3J9DQp0cmVuZC5sIDwtIGxtKGZvcm11bGEgPSBIIH4gWCArIFksIGRhdGEgPSBhcXVpZmVyKQ0Kc3VtbWFyeSh0cmVuZC5sKQ0KDQp1LnAgPC0gc2VxKGZyb20gPSAwLjAsIHRvID0gMS4wLCBieSA9IDAuMDUpDQp2LnAgPC0gc2VxKGZyb20gPSAwLjAsIHRvID0gMS4wLCBieSA9IDAuMDUpDQoNCnByZWRzIDwtIHByZWRpY3QodHJlbmQubCwgbmV3ZGF0YSA9IGFxdWlmZXIsIHNlLmZpdCA9IFRSVUUsIGludGVydmFsID0gInByZWRpY3Rpb24iLCBsZXZlbCA9IDAuOTUpDQoNCnoucCA8LSBtYXRyaXgoZGF0YSA9IHByZWRzJGZpdFssMV0sIG5yb3cgPSAyMSwgbmNvbCA9IDIxLCBieXJvdyA9IFRSVUUpDQp6LnBfbCA8LSBtYXRyaXgoZGF0YSA9IHByZWRzJGZpdFssMl0sIG5yb3cgPSAyMSwgbmNvbCA9IDIxLCBieXJvdyA9IFRSVUUpDQp6LnBfdSA8LSBtYXRyaXgoZGF0YSA9IHByZWRzJGZpdFssM10sIG5yb3cgPSAyMSwgbmNvbCA9IDIxLCBieXJvdyA9IFRSVUUpDQoNCnRyZW5kLnBsb3QgPC0gcGxvdF9seSh4ID0gfnUucCwgeSA9IH52LnAsIHogPSB+ei5wLCANCiAgICAgICAgdHlwZSA9ICJzdXJmYWNlIiwgY29sb3JzID0gIllsT3JSZCIpICU+JSANCiAgYWRkX3N1cmZhY2UoeCA9IH51LnAsIHkgPSB+di5wLCB6ID0gfnoucF9sLCANCiAgICAgICAgICAgICAgb3BhY2l0eSA9IDAuNSwgc2hvd3NjYWxlID0gRkFMU0UpICU+JQ0KICBhZGRfc3VyZmFjZSh4ID0gfnUucCwgeSA9IH52LnAsIHogPSB+ei5wX3UsIA0KICAgICAgICAgICAgICBvcGFjaXR5ID0gMC41LCBzaG93c2NhbGUgPSBGQUxTRSkgJT4lIA0KICBsYXlvdXQoc2NlbmUgPSBsaXN0KA0KICAgIGFzcGVjdG1vZGUgPSAibWFudWFsIiwgYXNwZWN0cmF0aW8gPSBsaXN0KHggPSAxLCB5ID0gMSwgeiA9IDEpKSkNCnRyZW5kLnBsb3QgIyU+JSBhZGRfbWFya2VycyhkYXRhID0gZGYsIHggPSB+eCwgeSA9IH55LCB6ID0gfnosIGNvbG9yID0gfnJlc2lkdWFsKQ0KYGBgDQoNCg0KMy4gRXN0aW1hdGUgYW5kIHBsb3QgYSB0aGVvcmV0aWNhbCBzZW1pdmFyaW9ncmFtIG1vZGVsIGZvciB0aGUgcmVzaWR1YWwgdmFyaW9ncmFtLiANCg0KYGBge3J9DQphcXVpZmVyJHJlc2lkdWFsMSA8LSBpZmVsc2UodHJlbmQubCRyZXNpZHVhbHMgPiAwLCAiUG9zaXRpdmUiLCAiTmVnYXRpdmUiKQ0KZ2dwbG90KGRhdGEgPSBhcXVpZmVyLCANCiAgICAgICBhZXMoeCA9IFgsIHkgPSBZLCBjb2xvciA9IHJlc2lkdWFsMSkpICsNCiAgZ2VvbV9wb2ludCgpICsNCiAgY29vcmRfZXF1YWwoKQ0KYGBgDQoNCjQuIEhvdyB3b3VsZCB5b3UgdXNlIHRoZSBpbmZvcm1hdGlvbiBwcm92aWRlZCBieSB0aGUgdmFyaW9ncmFwaGljIGFuYWx5c2lzIGFib3ZlIHRvIGltcHJvdmUgeW91ciBwcmVkaWN0aW9ucyBvZiB0aGUgZmllbGQ/